home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / libs / phigs / ptk.lha / ptk / fortran / source / library / wind.f < prev   
Encoding:
Text File  |  1992-06-18  |  59.5 KB  |  1,911 lines
  1. C----------------------------------------------------------------------------
  2.  
  3. C  Module name: PHIGS windows.
  4.  
  5. C  Author: Gareth Williams.
  6.  
  7. C  Function: This module contains functions for displaying PHIGS structures
  8. C            in windows.
  9.  
  10. C  Dependencies:
  11.  
  12. C  Internal function list: 
  13.  
  14. C  External function list: 
  15.  
  16. C  Hashtables used: "structureid", "name", "label", "viewindex".
  17.  
  18. C  Modification history: (Version), (Date), (name), (Description).
  19.  
  20. C  1.0, 5th September 1991, G. Williams, First version.
  21.  
  22. C----------------------------------------------------------------------------
  23.  
  24.        SUBROUTINE ptkf_createwindow(wsid, windid, size, position,
  25. & titlestr)
  26. C /* 
  27. C ** \parambegin
  28. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  29. C ** \param{INTEGER}{windid}{window identifier}{IN}
  30. C ** \param{REAL}{size(2)}{window size}{IN}
  31. C ** \param{REAL}{position(2)}{window position}{IN}
  32. C ** \param{CHARACTER*(*)}{titlestring}{title string}{IN}
  33. C ** \paramend
  34. C ** \blurb{This function creates a window structure which may be used
  35. C ** for viewing PHIGS structures, PHIGS Toolkit topology diagrams and
  36. C ** PHIGS Toolkit structure content diagrams. A terminal window
  37. C ** type which contains only text. The window size and position are
  38. C ** given in the range [0, 1]. Each window has a virtual camera
  39. C ** which is useful for moving around a scene.}
  40. C */
  41.        INTEGER wsid, windid
  42.        REAL size(2), position(2)
  43.        CHARACTER*(*) titlestr
  44.        CHARACTER*255 inbuf
  45.        external ptk_createwindow !$PRAGMA C(ptk_createwindow)
  46.  
  47.        inbuf = titlestr//'\0'
  48.        call ptk_createwindow(%val(wsid), %val(windid), size, position, 
  49. & inbuf)
  50.  
  51.        RETURN
  52.        END
  53.  
  54.        SUBROUTINE ptkf_setwindowattrs(windid, titlefont, titlecol,
  55. & bannercol, backgdcol, edgecol, frametlcol, framebrcol)
  56. C /* 
  57. C ** \parambegin
  58. C ** \param{INTEGER}{windid}{window identifier}{IN}
  59. C ** \param{INTEGER}{titlefont}{title string font}{IN}
  60. C ** \param{INTEGER}{titlecol}{title string colour index}{IN}
  61. C ** \param{INTEGER}{bannercol}{banner colour index}{IN}
  62. C ** \param{INTEGER}{backgdcol}{background colour index of window}{IN}
  63. C ** \param{INTEGER}{edgecol}{edge colour index of window}{IN}
  64. C ** \param{INTEGER}{frametlcol}{top-left frame colour index}{IN}
  65. C ** \param{INTEGER}{framebrcol}{bottom-right frame colour index}{IN}
  66. C ** \paramend
  67. C ** \blurb{This function sets the window text font and colour attribute
  68. C ** values. Each window has a banner region which contains the title
  69. C ** string of the window. The text font value applies to this string.} 
  70. C */
  71.        INTEGER windid, titlefont, titlecol, bannercol
  72.        INTEGER backgdcol, edgecol, frametlcol, framebrcol
  73.        external ptk_setwindowattrs !$PRAGMA C(ptk_setwindowattrs)
  74.  
  75.        call ptk_setwindowattrs(%val(windid), %val(titlefont),
  76. & %val(titlecol), %val(bannercol), %val(backgdcol), 
  77. & %val(edgecol), %val(frametlcol), %val(framebrcol))
  78.  
  79.        RETURN
  80.        END
  81.  
  82.        SUBROUTINE ptkf_inqwindowattrs(windid, titlefont, titlecol,
  83. & bannercol, backgdcol, edgecol, frametlcol, framebrcol, err)
  84. C /* 
  85. C ** \parambegin
  86. C ** \param{INTEGER}{windid}{window identifier}{IN}
  87. C ** \param{INTEGER}{titlefont}{title string font}{OUT}
  88. C ** \param{INTEGER}{titlecol}{title string colour index}{OUT}
  89. C ** \param{INTEGER}{bannercol}{banner colour index}{OUT}
  90. C ** \param{INTEGER}{backgdcol}{background colour index of window}{OUT}
  91. C ** \param{INTEGER}{edgecol}{edge colour index of window}{OUT}
  92. C ** \param{INTEGER}{frametlcol}{top-left frame colour index}{OUT}
  93. C ** \param{INTEGER}{framebrcol}{bottom-right frame colour index}{OUT}
  94. C ** \param{INTEGER}{err}{error indicator}{OUT}
  95. C ** \paramend
  96. C ** \blurb{This function may be used to obtain the text font and
  97. C ** colour attribute values of a window.}
  98. C */
  99.        INTEGER windid, titlefont, titlecol, bannercol
  100.        INTEGER backgdcol, edgecol, frametlcol, framebrcol, err
  101.        external ptk_inqwindowattrs !$PRAGMA C(ptk_inqwindowattrs)
  102.  
  103.        call ptk_inqwindowattrs(%val(windid), titlefont,
  104. & titlecol, bannercol, backgdcol, 
  105. & edgecol, frametlcol, framebrcol, err)
  106.  
  107.        RETURN
  108.        END
  109.  
  110.        SUBROUTINE ptkf_posttowindow(windid, id)
  111. C /*
  112. C ** \parambegin
  113. C ** \param{INTEGER}{windid}{window identifier}{IN}
  114. C ** \param{INTEGER}{id}{item identifier}{IN}
  115. C ** \paramend
  116. C ** \blurb{This function posts an item to a window depending on the 
  117. C ** window type. In the case
  118. C ** of STRUCT and CONTENT windows, {\tt id} is a structure identifier.
  119. C ** For TOPOLOGY windows, {\tt id} is a topology identifier. If the window is
  120. C ** a TERMINAL window this function is ignored.}
  121. C */
  122.        INTEGER windid, id
  123.        external ptk_posttowindow !$PRAGMA C(ptk_posttowindow)
  124.  
  125.        call ptk_posttowindow(%val(windid), %val(id))
  126.  
  127.        RETURN
  128.        END
  129.  
  130.        SUBROUTINE ptkf_unpostfromwindow(windid, id)
  131. C /*
  132. C ** \parambegin
  133. C ** \param{INTEGER}{windid}{window identifier}{IN}
  134. C ** \param{INTEGER}{id}{item identifier}{IN}
  135. C ** \paramend
  136. C ** \blurb{This function unposts an item from a window depending on the
  137. C ** window type. In the case
  138. C ** of STRUCT and CONTENT windows, id is a structure identifier.
  139. C ** For TOPOLOGY windows, id is a topology identifier. If the window is
  140. C ** a TERMINAL window this function is ignored.}
  141. C */
  142.        INTEGER windid, id
  143.        external ptk_unpostfromwindow !$PRAGMA C(ptk_unpostfromwindow)
  144.  
  145.        call ptk_unpostfromwindow(%val(windid), %val(id))
  146.  
  147.        RETURN
  148.        END
  149.  
  150.        SUBROUTINE ptkf_unpostallfromwindow(windid)
  151. C /*
  152. C ** \parambegin
  153. C ** \param{INTEGER}{windid}{window identifier}{IN}
  154. C ** \paramend 
  155. C ** \blurb{This function unposts all items posted to window {\tt windid}.}
  156. C */
  157.        INTEGER windid
  158.        external ptk_unpostallfromwindow 
  159. & !$PRAGMA C(ptk_unpostallfromwindow)
  160.  
  161.        call ptk_unpostallfromwindow(%val(windid))
  162.  
  163.        RETURN
  164.        END
  165.  
  166.        SUBROUTINE ptkf_postwindow(windid)
  167. C /*
  168. C ** \parambegin
  169. C ** \param{INTEGER}{windid}{window identifier}{IN}
  170. C ** \paramend
  171. C ** \blurb{This function posts a window structure to the workstation
  172. C ** specified when the window was initially created. Windows are bound
  173. C ** to workstation because they each use one view table entry to
  174. C ** define the window view. The priority of the window structure is
  175. C ** controlled by the PHIGS Toolkit window system to provide an ordered
  176. C ** stacking mechanism for windows.}
  177. C */
  178.        INTEGER windid
  179.        external ptk_postwindow !$PRAGMA C(ptk_postwindow)
  180.  
  181.        call ptk_postwindow(%val(windid))
  182.  
  183.        RETURN
  184.        END
  185.  
  186.        SUBROUTINE ptkf_unpostwindow(windid)
  187. C /*
  188. C ** \parambegin
  189. C ** \param{INTEGER}{windid}{window identifier}{IN}
  190. C ** \paramend
  191. C ** \blurb{This function unposts a window from the workstation it is
  192. C ** bound to.}
  193. C */
  194.        INTEGER windid
  195.        external ptk_unpostwindow !$PRAGMA C(ptk_unpostwindow)
  196.  
  197.        call ptk_unpostwindow(%val(windid))
  198.  
  199.        RETURN
  200.        END
  201.  
  202.        LOGICAL FUNCTION ptkf_delwindow(windid)
  203. C /*
  204. C ** \parambegin
  205. C ** \param{INTEGER}{windid}{window identifier}{IN}
  206. C ** \paramend
  207. C ** \blurb{This function deletes a window from the PHIGS Toolkit window
  208. C ** store.}
  209. C */
  210.        INTEGER windid
  211.        external ptk_delwindow !$PRAGMA C(ptk_delwindow)
  212.  
  213.        ans = ptk_delwindow(%val(windid))
  214.        if (ans .eq. 1) then
  215.           ptkf_delwindow = .TRUE.
  216.        else
  217.           ptkf_delwindow = .FALSE.
  218.        endif
  219.  
  220.        RETURN
  221.        END
  222.  
  223.        SUBROUTINE ptkf_closewindow(windid)
  224. C /*
  225. C ** \parambegin
  226. C ** \param{INTEGER}{windid}{window identifier}{IN}
  227. C ** \paramend 
  228. C ** \blurb{This function posts the icon structure and unposts the window
  229. C ** structure from the window's workstation.}
  230. C */
  231.        INTEGER windid
  232.        external ptk_closewindow !$PRAGMA C(ptk_closewindow)
  233.  
  234.        call ptk_closewindow(%val(windid))
  235.  
  236.        RETURN
  237.        END
  238.  
  239.        SUBROUTINE ptkf_openwindow(windid)
  240. C /*
  241. C ** \parambegin
  242. C ** \param{INTEGER}{windid}{window identifier}{IN}
  243. C ** \paramend 
  244. C ** \blurb{This function posts the window structure and unposts the icon
  245. C ** structure from the window's workstation.}
  246. C */
  247.        INTEGER windid
  248.        external ptk_openwindow !$PRAGMA C(ptk_openwindow)
  249.  
  250.        call ptk_openwindow(%val(windid))
  251.  
  252.        RETURN
  253.        END
  254.  
  255.        SUBROUTINE ptkf_setwindowposition(windid, position)
  256. C /*
  257. C ** \parambegin
  258. C ** \param{INTEGER}{windid}{window identifier}{IN}
  259. C ** \param{REAL}{position(2)}{window position}{IN}
  260. C ** \paramend 
  261. C ** \blurb{This function sets the position of the centre of the window.
  262. C ** The position is given in the range [0, 1]. If the position results
  263. C ** in part of the window being clipped then the position is adjusted
  264. C ** so that the whole window is visible.}
  265. C */
  266.        INTEGER windid
  267.        REAL position(2)
  268.        external ptk_setwindowposition !$PRAGMA C(ptk_setwindowposition)
  269.  
  270.        call ptk_setwindowposition(%val(windid), position)
  271.  
  272.        RETURN
  273.        END
  274.  
  275.        SUBROUTINE ptkf_setwindowsize(windid, size)
  276. C /*
  277. C ** \parambegin
  278. C ** \param{INTEGER}{windid}{window identifier}{IN}
  279. C ** \param{REAL}{size(2)}{window size}{IN}
  280. C ** \paramend 
  281. C ** \blurb{This function sets the size of the window using the x value
  282. C ** as the width and the y value as the height. The values are given
  283. C ** in the range [0, 1]. If the size results in part of the window
  284. C ** being clipped then the window size is adjusted to give as large a
  285. C ** window as possible.}
  286. C */
  287.        INTEGER windid
  288.        REAL size(2)
  289.        external ptk_setwindowsize !$PRAGMA C(ptk_setwindowsize)
  290.  
  291.        call ptk_setwindowsize(%val(windid), size)
  292.  
  293.        RETURN
  294.        END
  295.  
  296.        SUBROUTINE ptkf_setwindowtraninputpri(windid, refwindid, 
  297. & priority)
  298. C /*
  299. C ** \parambegin
  300. C ** \param{INTEGER}{windid}{window identifier}{IN}
  301. C ** \param{INTEGER}{refwindid}{reference window identifier}{IN}
  302. C ** \param{INTEGER}{priority}{relative priority}{IN}
  303. C ** \paramend 
  304. C ** \blurb{This function sets the transformation input priority of the 
  305. C ** window's view representation relative to another window.
  306. C ** The relative priority is also set relative to view index 0.}
  307. C */
  308.        INTEGER windid, refwindid, priority
  309.        external ptk_setwindowtraninputpri 
  310. & !$PRAGMA C(ptk_setwindowtraninputpri)
  311.  
  312.        call ptk_setwindowtraninputpri(%val(windid), %val(refwindid), 
  313. & %val(priority))
  314.  
  315.        RETURN
  316.        END
  317.  
  318.        SUBROUTINE ptkf_setframesize(windid, size)
  319. C /*
  320. C ** \parambegin
  321. C ** \param{INTEGER}{windid}{window identifier}{IN}
  322. C ** \param{REAL}{size(2)}{frame size}{IN}
  323. C ** \paramend 
  324. C ** \blurb{This function sets the thickness of the window frame. The
  325. C ** x and y dimensions are given in the range [0, 1].}
  326. C */
  327.        INTEGER windid
  328.        REAL size(2)
  329.        external ptk_setframesize !$PRAGMA C(ptk_setframesize)
  330.  
  331.        call ptk_setframesize(%val(windid), size)
  332.  
  333.        RETURN
  334.        END
  335.        
  336.        LOGICAL FUNCTION ptkf_stringscanwindows(wsid, str, windowid)
  337. C /*
  338. C ** \parambegin
  339. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  340. C ** \param{CHARACTER*(*)}{str}{string}{IN}
  341. C ** \param{INTEGER}{windowid}{window identifier}{OUT}
  342. C ** \paramend
  343. C ** \blurb{This function compares the character string {\tt str} with
  344. C ** title string of all the windows posted to workstation {\tt wsid}.
  345. C ** The string comparison is case sensitive and begins with the
  346. C ** front window and works back to the lowest priority window.
  347. C ** The function returns TRUE if a match is found, otherwise FALSE.}
  348. C */
  349.        INTEGER wsid
  350.        CHARACTER*(*) str
  351.        INTEGER windowid
  352.        LOGICAL*1 ptk_stringscanwindows, ans
  353.        external ptk_stringscanwindows !$PRAGMA C(ptk_stringscanwindows)
  354.  
  355.        ans = ptk_stringscanwindows(%val(wsid), str, windowid)
  356.        if (ans .eq. 1) then
  357.           ptkf_stringscanwindows = .TRUE.
  358.        else
  359.           ptkf_stringscanwindows = .FALSE.
  360.        endif
  361.  
  362.        RETURN
  363.        END
  364.  
  365.        LOGICAL FUNCTION ptkf_pickscanwindows(ippd, pp, ppordr, windowid)
  366. C /*
  367. C ** \parambegin
  368. C ** \param{INTEGER}{ippd}{depth of pick path}{IN}
  369. C ** \param{INTEGER}{pp(3, ippd)}{pick path through structure network.}{IN}
  370. C ** \param{INTEGER}{ppordr}{order of data in pickpath}{IN}
  371. C ** \param{INTEGER}{windowid}{window identifier}{OUT}
  372. C ** \paramend
  373. C ** \blurb{This function tests the pick path to inquire if a window 
  374. C ** structure was picked. The window area picked may be one of
  375. C ** BANNER, VIEW, FRAME or ICON. The function
  376. C ** returns TRUE if a window was picked, otherwise FALSE.}
  377. C */
  378.        INTEGER ippd
  379.        INTEGER pp(3, ippd)
  380.        INTEGER ppordr
  381.        INTEGER windowid
  382.        LOGICAL*1 ptk_pickscanwindows, ans
  383.        external ptk_pickscanwindows !$PRAGMA C(ptk_pickscanwindows)
  384.        structure /Ppickpath/
  385.          INTEGER depth
  386.          INTEGER pick_path(3, 100)
  387.        end structure
  388.        record /Ppickpath/ ppath
  389.  
  390.        ppath.depth = ippd
  391.        do 10, i=1,ippd
  392.           ppath.pick_path(1, i) = pp(1, i)
  393.           ppath.pick_path(2, i) = pp(2, i)
  394.  10       ppath.pick_path(3, i) = pp(3, i)
  395.        ans = ptk_pickscanwindows(ppath, %val(ppordr), windowid)
  396.        if (ans .eq. 1) then
  397.           ptkf_pickscanwindows = .TRUE.
  398.        else
  399.           ptkf_pickscanwindows = .FALSE.
  400.        endif
  401.  
  402.        RETURN
  403.        END
  404.  
  405.        LOGICAL FUNCTION ptkf_locscanwindows(wsid, point, windowid, 
  406. & windarea, value)
  407. C /*
  408. C ** \parambegin
  409. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  410. C ** \param{REAL}{point(2)}{input point}{IN}
  411. C ** \param{INTEGER}{windowid}{window identifier}{OUT}
  412. C ** \param{INTEGER}{windowarea}{window area}{OUT}
  413. C ** \param{REAL}{value(2)}{position of point within window area}{OUT}
  414. C ** \paramend
  415. C ** \blurb{This function uses the INCREMENTAL SPATIAL SEARCH function 
  416. C ** of PHIGS to test if {\tt point} lies within a window
  417. C ** posted to workstation {\tt wsid}. The window area (one of
  418. C ** BANNER, VIEW, FRAME or ICON) and the position of {\tt point} relative
  419. C ** to the bottom-left corner of the bounding box of the window area are
  420. C ** returned in {\tt windowarea} and {\tt value}.
  421. C ** The function returns TRUE if {\tt point} lies within a window,
  422. C ** otherwise FALSE.}
  423. C */
  424.        INTEGER wsid
  425.        REAL point(2)
  426.        INTEGER windowid, windarea
  427.        REAL value(2)
  428.        LOGICAL*1 ptk_locscanwindows, ans
  429.        external ptk_locscanwindows !$PRAGMA C(ptk_locscanwindows)
  430.  
  431.        ans = ptk_locscanwindows(%val(wsid), point, windowid, windarea, 
  432. & value)
  433.        if (ans .eq. 1) then
  434.           ptkf_locscanwindows = .TRUE.
  435.        else
  436.           ptkf_locscanwindows = .FALSE.
  437.        endif
  438.  
  439.        RETURN
  440.        END
  441.  
  442.        SUBROUTINE ptkf_frontwindow(windid)
  443. C /*
  444. C ** \parambegin
  445. C ** \param{INTEGER}{windid}{window identifier}{IN}
  446. C ** \paramend 
  447. C ** \blurb{This function sets the post priority of the window structure
  448. C ** so that it is displayed on top of all other posted windows but
  449. C ** has a lower prioity than the current back menu.}
  450. C */
  451.        INTEGER windid
  452.        external ptk_frontwindow !$PRAGMA C(ptk_frontwindow)
  453.  
  454.        call ptk_frontwindow(%val(windid))
  455.  
  456.        RETURN
  457.        END
  458.  
  459.        SUBROUTINE ptkf_backwindow(windid)
  460. C /*
  461. C ** \parambegin
  462. C ** \param{INTEGER}{windid}{window identifier}{IN}
  463. C ** \paramend 
  464. C ** \blurb{This function sets the post priority of a window structure
  465. C ** so that it is displayed behind all the other posted windows and menus.}
  466. C */
  467.        INTEGER windid
  468.        external ptk_backwindow !$PRAGMA C(ptk_backwindow)
  469.  
  470.        call ptk_backwindow(%val(windid))
  471.  
  472.        RETURN
  473.        END
  474.  
  475.        SUBROUTINE ptkf_inqpostedwindows(wsid, num, windowids, totalnum,
  476. & err)
  477. C /*
  478. C ** \parambegin
  479. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  480. C ** \param{INTEGER}{num}{size of array}{IN}
  481. C ** \param{INTEGER}{windowids(*)}{list of posted windows}{OUT}
  482. C ** \param{INTEGER}{totalnum}{length of posted windows list}{OUT}
  483. C ** \param{INTEGER}{err}{error indicator}{OUT}
  484. C ** \paramend
  485. C ** \blurb{This function may be used to obtain a list of all windows
  486. C ** posted to the workstation {\tt wsid}.}
  487. C */
  488.        INTEGER wsid, num, windowids(num), totalnum, err
  489.        external ptkc_inqpostedwindows !$PRAGMA C(ptkc_inqpostedwindows)
  490.  
  491.        call ptkc_inqpostedwindows(%val(wsid), %val(num), windowids, 
  492. & totalnum, err)
  493.  
  494.        RETURN
  495.        END
  496.  
  497.        SUBROUTINE ptkf_inqwindowids(num, windowids, totalnum, err)
  498. C /*
  499. C ** \parambegin
  500. C ** \param{INTEGER}{num}{size of array}{IN}
  501. C ** \param{INTEGER}{windowids(*)}{list of windows}{OUT}
  502. C ** \param{INTEGER}{totalnum}{length of windows list}{OUT}
  503. C ** \param{INTEGER}{err}{error indicator}{OUT}
  504. C ** \paramend
  505. C ** \blurb{This function may be used to obtain a list of all
  506. C ** windows in the PHIGS Toolkit window store.}
  507. C */
  508.        INTEGER num, windowids(num), totalnum, err
  509.        external ptkc_inqwindowids !$PRAGMA C(ptkc_inqwindowids)
  510.  
  511.        call ptkc_inqwindowids(%val(num), windowids, totalnum, err)
  512.  
  513.        RETURN
  514.        END
  515.  
  516.        SUBROUTINE ptkf_inqwindowstructid(windid, windowstid, iconstid,
  517. & err)
  518. C /*
  519. C ** \parambegin
  520. C ** \param{INTEGER}{windid}{window identifier}{IN}
  521. C ** \param{INTEGER}{windowstid}{window structure identifier}{OUT}
  522. C ** \param{INTEGER}{iconstid}{window structure identifier}{OUT}
  523. C ** \param{INTEGER}{err}{error indicator}{OUT}
  524. C ** \paramend
  525. C ** \blurb{This function may be used to obtain the identifier of
  526. C ** a window structure and its corresponding icon structure.
  527. C ** The window structure is a network with references to all the items
  528. C ** posted to the window. The default icon is a single structure
  529. C ** containing the window identifier.}
  530. C */
  531.        INTEGER windid, windowstid, iconstid, err
  532.        external ptk_inqwindowstructid !$PRAGMA C(ptk_inqwindowstructid)
  533.  
  534.        call ptk_inqwindowstructid(%val(windid), windowstid, iconstid,
  535. & err)
  536.  
  537.        RETURN
  538.        END
  539.  
  540.        SUBROUTINE ptkf_inqwindowname(windid, name, err)
  541. C /*
  542. C ** \parambegin
  543. C ** \param{INTEGER}{windid}{window identifier}{IN}
  544. C ** \param{INTEGER}{name}{window name}{OUT}
  545. C ** \param{INTEGER}{err}{error indicator}{OUT}
  546. C ** \paramend
  547. C ** \blurb{This function may be used to obtain the window name 
  548. C ** to be used in namesets for the pick, invisibility and 
  549. C ** highlighting filters.}
  550. C */
  551.        INTEGER windid, name, err
  552.        external ptk_inqwindowname !$PRAGMA C(ptk_inqwindowname)
  553.  
  554.        call ptk_inqwindowname(%val(windid), name, err)
  555.  
  556.        RETURN
  557.        END
  558.  
  559.        SUBROUTINE ptkf_inqwindowstate(windid, state, err)
  560. C /*
  561. C ** \parambegin
  562. C ** \param{INTEGER}{windid}{window identifier}{IN}
  563. C ** \param{INTEGER}{state}{window state}{OUT}
  564. C ** \param{INTEGER}{err}{error indicator}{OUT}
  565. C ** \paramend
  566. C ** \blurb{This function may be used to obtain the window state,
  567. C ** open or closed.
  568. C ** The error code = 1 if {\tt windid} doesn't exist.}
  569. C */
  570.        INTEGER windid, state, err
  571.        external ptk_inqwindowstate !$PRAGMA C(ptk_inqwindowstate)
  572.  
  573.        call ptk_inqwindowstate(%val(windid), state, err)
  574.  
  575.        RETURN
  576.        END
  577.  
  578.        LOGICAL FUNCTION ptkf_inqfrontbackwindowid(wsid, frontid, 
  579. & frontstate, backid, backstate, err)
  580. C /*
  581. C ** \parambegin
  582. C ** \param{INTEGER}{wsid}{workstation identifier}{IN}
  583. C ** \param{INTEGER}{frontstid}{front window identifier}{OUT}
  584. C ** \param{INTEGER}{frontstate}{front window state}{OUT}
  585. C ** \param{INTEGER}{backstid}{back window identifier}{OUT}
  586. C ** \param{INTEGER}{backstate}{back window state}{OUT}
  587. C ** \param{INTEGER}{err}{error indicator}{OUT}
  588. C ** \paramend
  589. C ** \blurb{This function may be used to obtain the identifiers
  590. C ** of the front and back windows and there current state (OPEN or
  591. C ** CLOSED).}
  592. C */
  593.        INTEGER wsid, frontid, frontstate, backid, backstate, err
  594.        LOGICAL*1 ptk_inqfrontbackwindowid, ans
  595.        external ptk_inqfrontbackwindowid 
  596. & !$PRAGMA C(ptk_inqfrontbackwindowid)
  597.  
  598.        ans = ptk_inqfrontbackwindowid(%val(wsid), frontid, frontstate, 
  599. & backid, backstate, err)
  600.        if (ans .eq. 1) then
  601.           ptkf_inqfrontbackwindowid = .TRUE.
  602.        else
  603.           ptkf_inqfrontbackwindowid = .FALSE.
  604.        endif
  605.  
  606.        RETURN
  607.        END
  608.  
  609.        SUBROUTINE ptkf_inqwindowposition(windid, position, err)
  610. C /*
  611. C ** \parambegin
  612. C ** \param{INTEGER}{windid}{window identifier}{IN}
  613. C ** \param{REAL}{position(2)}{window position}{OUT}
  614. C ** \param{INTEGER}{err}{error indicator}{OUT}
  615. C ** \paramend
  616. C ** \blurb{This function may be used to obtain the position of the centre
  617. C ** of a window. The position is returned in the range [0, 1].}
  618. C */
  619.        INTEGER windid
  620.        REAL position(2)
  621.        INTEGER err
  622.        external ptk_inqwindowposition !$PRAGMA C(ptk_inqwindowposition)
  623.  
  624.        call ptk_inqwindowposition(%val(windid), position, err)
  625.  
  626.        RETURN
  627.        END
  628.  
  629.        SUBROUTINE ptkf_inqwindowsize(windid, size, err)
  630. C /*
  631. C ** \parambegin
  632. C ** \param{INTEGER}{windid}{window identifier}{IN}
  633. C ** \param{REAL}{size(2)}{window size}{OUT}
  634. C ** \param{INTEGER}{err}{error indicator}{OUT}
  635. C ** \paramend
  636. C ** \blurb{This function may be used to obtain the size of a window
  637. C ** which is returned in the range [0, 1].}
  638. C */
  639.        INTEGER windid
  640.        REAL size(2)
  641.        INTEGER err
  642.        external ptk_inqwindowsize !$PRAGMA C(ptk_inqwindowsize)
  643.  
  644.        call ptk_inqwindowsize(%val(windid), size, err)
  645.  
  646.        RETURN
  647.        END
  648.  
  649.        SUBROUTINE ptkf_inqiconposition(windid, position, err)
  650. C /*
  651. C ** \parambegin
  652. C ** \param{INTEGER}{windid}{window identifier}{IN}
  653. C ** \param{REAL}{position(2)}{icon position}{OUT}
  654. C ** \param{INTEGER}{err}{error indicator}{OUT}
  655. C ** \paramend
  656. C ** \blurb{This function may be used to obtain the position of the centre of 
  657. C ** a window icon which is returned in the range [0, 1].}
  658. C */
  659.        INTEGER windid
  660.        REAL position(2)
  661.        INTEGER err
  662.        external ptk_inqiconposition !$PRAGMA C(ptk_inqiconposition)
  663.  
  664.        call ptk_inqiconposition(%val(windid), position, err)
  665.  
  666.        RETURN
  667.        END
  668.  
  669.        SUBROUTINE ptkf_inqiconsize(windid, size, err)
  670. C /*
  671. C ** \parambegin
  672. C ** \param{INTEGER}{windid}{window identifier}{IN}
  673. C ** \param{REAL}{size(2)}{icon size}{OUT}
  674. C ** \param{INTEGER}{err}{error indicator}{OUT}
  675. C ** \paramend
  676. C ** \blurb{This function may be used to obtain the size of a window's icon
  677. C ** structure and is returned in the range [0, 1].}
  678. C */
  679.        INTEGER windid
  680.        REAL size(2)
  681.        INTEGER err
  682.        external ptk_inqiconsize !$PRAGMA C(ptk_inqiconsize)
  683.  
  684.        call ptk_inqiconsize(%val(windid), size, err)
  685.  
  686.        RETURN
  687.        END
  688.  
  689.        SUBROUTINE ptkf_inqusericon(windid, iconstid, err)
  690. C /*
  691. C ** \parambegin
  692. C ** \param{INTEGER}{windid}{window identifier}{IN}
  693. C ** \param{INTEGER}{iconstid}{user icon structure identifier}{OUT}
  694. C ** \param{INTEGER}{err}{error indicator}{OUT}
  695. C ** \paramend
  696. C ** \blurb{This function may be used to obtain the identifier of a
  697. C ** user created icon structure. The structure is referenced by the
  698. C ** window's icon structure.}
  699. C */
  700.        INTEGER windid, iconstid, err
  701.        external ptk_inqusericon !$PRAGMA C(ptk_inqusericon)
  702.  
  703.        call ptk_inqusericon(%val(windid), iconstid, err)
  704.  
  705.        RETURN
  706.        END
  707.  
  708.        SUBROUTINE ptkf_inqframesize(windid, size, err)
  709. C /*
  710. C ** \parambegin
  711. C ** \param{INTEGER}{windid}{window identifier}{IN}
  712. C ** \param{REAL}{size(2)}{frame size}{OUT}
  713. C ** \param{INTEGER}{err}{error indicator}{OUT}
  714. C ** \paramend
  715. C ** \blurb{This function may be used to obtain the dimensions of the
  716. C ** window frame. They are returned in the range [0, 1] and the default
  717. C ** dimensions are (0.01, 0.01).}
  718. C */
  719.        INTEGER windid
  720.        REAL size(2)
  721.        INTEGER err
  722.        external ptk_inqframesize !$PRAGMA C(ptk_inqframesize)
  723.  
  724.        call ptk_inqframesize(%val(windid), size, err)
  725.  
  726.        RETURN
  727.        END
  728.  
  729.        SUBROUTINE ptkf_inqwindowtype(windid, type, err)
  730. C /*
  731. C ** \parambegin
  732. C ** \param{INTEGER}{windid}{window identifier}{IN}
  733. C ** \param{INTEGER}{type}{window type}{OUT}
  734. C ** \param{INTEGER}{err}{error indicator}{OUT}
  735. C ** \paramend
  736. C ** \blurb{This function may be used to inquire the type of a window.
  737. C ** The available types are STRUCT, TOPOLOGY, CONTENT and TERMINAL.
  738. C ** The default window type is STRUCT and may be used to view any PHIGS
  739. C ** structures.}
  740. C */
  741.        INTEGER windid, type, err
  742.        external ptk_inqwindowtype !$PRAGMA C(ptk_inqwindowtype)
  743.  
  744.        call ptk_inqwindowtype(%val(windid), type, err)
  745.  
  746.        RETURN
  747.        END
  748.  
  749.        SUBROUTINE ptkf_inqbannerheight(windid, height, err)
  750. C /*
  751. C ** \parambegin
  752. C ** \param{INTEGER}{windid}{window identifier}{IN}
  753. C ** \param{REAL}{bannerheight}{height of banner}{OUT}
  754. C ** \param{INTEGER}{err}{error indicator}{OUT}
  755. C ** \paramend 
  756. C ** \blurb{This function may be used to obtain the height of a window
  757. C ** banner. It is returned in the range [0, 1].}
  758. C */
  759.        INTEGER windid
  760.        REAL height
  761.        INTEGER err
  762.        external ptk_inqbannerheight !$PRAGMA C(ptk_inqbannerheight)
  763.  
  764.        call ptk_inqbannerheight(%val(windid), height, err)
  765.  
  766.        RETURN
  767.        END
  768.  
  769.        SUBROUTINE ptkf_inqbannertitle(windid, len, titlestr, totlen,
  770. & err)
  771. C /*
  772. C ** \parambegin
  773. C ** \param{INTEGER}{windid}{window identifier}{IN}
  774. C ** \param{INTEGER}{len}{length of string}{IN}
  775. C ** \param{CHARACTER*(*)}{titlestr}{title string of banner}{IN}
  776. C ** \param{INTEGER}{totlen}{actual length of string}{OUT}
  777. C ** \param{INTEGER}{err}{error indicator}{OUT}
  778. C ** \paramend 
  779. C ** \blurb{This function may be used to obtain the title of a window.}
  780. C */
  781.        INTEGER windid, len
  782.        CHARACTER*(*) titlestr
  783.        INTEGER totlen, err
  784.        CHARACTER*255 inbuf
  785.        external ptk_inqbannertitle !$PRAGMA C(ptk_inqbannertitle)
  786.  
  787.        call ptk_inqbannertitle(windid, %val(len), titlestr, totlen,
  788. & err) 
  789.        totlen = totlen - 1
  790.        if (len .le. 255) then
  791.          titlestr = inbuf(1:totlen)
  792.        endif
  793.  
  794.        RETURN
  795.        END
  796.  
  797. C icon functions 
  798.  
  799.        SUBROUTINE ptkf_seticonposition(windid, position)
  800. C /*
  801. C ** \parambegin
  802. C ** \param{INTEGER}{windid}{window identifier}{IN}
  803. C ** \param{REAL}{position(2)}{icon position}{IN}
  804. C ** \paramend 
  805. C ** \blurb{This function sets the position of the centre
  806. C ** of the window's icon structure.
  807. C ** The position is given in the range [0, 1].}
  808. C */
  809.        INTEGER windid
  810.        REAL position(2)
  811.        external ptk_seticonposition !$PRAGMA C(ptk_seticonposition)
  812.  
  813.        call ptk_seticonposition(%val(windid), position)
  814.  
  815.        RETURN
  816.        END
  817.  
  818.        SUBROUTINE ptkf_seticonsize(windid, size)
  819. C /*
  820. C ** \parambegin
  821. C ** \param{INTEGER}{windid}{window identifier}{IN}
  822. C ** \param{REAL}{size(2)}{icon size}{IN}
  823. C ** \paramend 
  824. C ** \blurb{This function sets the size of the window's icon structure.
  825. C ** The size is given in the range [0, 1].}
  826. C */
  827.        INTEGER windid
  828.        REAL size(2)
  829.        external ptk_seticonsize !$PRAGMA C(ptk_seticonsize)
  830.  
  831.        call ptk_seticonsize(%val(windid), size)
  832.  
  833.        RETURN
  834.        END
  835.  
  836.        SUBROUTINE ptkf_setusericon(windid, usericon)
  837. C /*
  838. C ** \parambegin
  839. C ** \param{INTEGER}{windid}{window identifier}{IN}
  840. C ** \param{INTEGER}{user icon}{icon structure identifier}{IN}
  841. C ** \paramend 
  842. C ** \blurb{This function enables the application to specify a structure
  843. C ** identifier to use as a window icon. The structure is executed from
  844. C ** the window's default icon structure and the icon size and position
  845. C ** functions still apply provided the user icon is defined within
  846. C ** the World Coordinate range [0, 1].}
  847. C */
  848.        INTEGER windid, usericon
  849.        external ptk_setusericon !$PRAGMA C(ptk_setusericon)
  850.  
  851.        call ptk_setusericon(%val(windid), %val(usericon))
  852.  
  853.        RETURN
  854.        END
  855.  
  856. C banner functions 
  857.  
  858.        SUBROUTINE ptkf_setbannercolours(windid, bannercolour, 
  859. & titlecolour)
  860. C /*
  861. C ** \parambegin
  862. C ** \param{INTEGER}{windid}{window identifier}{IN}
  863. C ** \param{INTEGER}{bannercolour}{banner colour index}{IN}
  864. C ** \param{INTEGER}{titlecolour}{title string colour index}{IN}
  865. C ** \paramend 
  866. C ** \blurb{This function sets the colour indicies of a window banner.
  867. C ** It is useful for highlighting a current window, for example
  868. C ** in a `point and click' window system.}
  869. C */
  870.        INTEGER windid, bannercolour, titlecolour
  871.        external ptk_setbannercolours !$PRAGMA C(ptk_setbannercolours)
  872.  
  873.        call ptk_setbannercolours(%val(windid), %val(bannercolour), 
  874. & %val(titlecolour))
  875.  
  876.        RETURN
  877.        END
  878.  
  879.        SUBROUTINE ptkf_setbannerheight(windid, bannerheight)
  880. C /*
  881. C ** \parambegin
  882. C ** \param{INTEGER}{windid}{window identifier}{IN}
  883. C ** \param{REAL}{bannerheight}{height of banner}{IN}
  884. C ** \paramend 
  885. C ** \blurb{This function sets the height of the window banner to
  886. C ** {\tt bannerheight} which is given in the range [0, 1]. The window
  887. C ** title is re-scaled to fit the new height.}
  888. C */
  889.        INTEGER windid
  890.        REAL bannerheight
  891.        REAL*8 dpbannerheight
  892.        external ptk_setbannerheight !$PRAGMA C(ptk_setbannerheight)
  893.  
  894.        dpbannerheight = bannerheight
  895.        call ptk_setbannerheight(%val(windid), %val(dpbannerheight))
  896.  
  897.        RETURN
  898.        END
  899.  
  900.        SUBROUTINE ptkf_setbannertitle(windid, titlestring)
  901. C /*
  902. C ** \parambegin
  903. C ** \param{INTEGER}{windid}{window identifier}{IN}
  904. C ** \param{CHARACTER*(*)}{titlestring}{title string of window banner}{IN}
  905. C ** \paramend 
  906. C ** \blurb{This function sets the title string of a window. The title
  907. C ** is displayed in the window banner and is automatically scaled to
  908. C ** fit inside the banner area.}
  909. C */
  910.        INTEGER windid
  911.        CHARACTER*(*) titlestring
  912.        CHARACTER*255 inbuf
  913.        external ptk_setbannertitle !$PRAGMA C(ptk_setbannertitle)
  914.  
  915.        inbuf = titlestring//'\0'
  916.        call ptk_setbannertitle(%val(windid), inbuf)
  917.  
  918.        RETURN
  919.        END
  920.  
  921. C terminal window functions
  922.  
  923.        SUBROUTINE ptkf_setterminaldata(windid, numlines, txfont, 
  924. & txcolour)
  925. C /*
  926. C ** \parambegin
  927. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  928. C ** \param{INTEGER}{numlines}{number of lines in window}{IN}
  929. C ** \param{INTEGER}{txfont}{text font}{IN}
  930. C ** \param{INTEGER}{txcolour}{text colour}{IN}
  931. C ** \paramend
  932. C ** \blurb{This function sets the number of lines to be displayed in a 
  933. C ** TERMINAL window and which text font and colour to use.}
  934. C */
  935.        INTEGER windid, numlines, txfont, txcolour
  936.        external ptk_setterminaldata !$PRAGMA C(ptk_setterminaldata)
  937.  
  938.        call ptk_setterminaldata(%val(windid), %val(numlines), 
  939. & %val(txfont), %val(txcolour))
  940.  
  941.        RETURN
  942.        END
  943.  
  944.        SUBROUTINE ptkf_refreshterminal(windid)
  945. C /*
  946. C ** \parambegin
  947. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  948. C ** \paramend
  949. C ** \blurb{This function refreshes the TERMINAL window so that the
  950. C ** last text line is visible.}
  951. C */
  952.        INTEGER windid
  953.        external ptk_refreshterminal !$PRAGMA C(ptk_refreshterminal)
  954.  
  955.        call ptk_refreshterminal(%val(windid))
  956.  
  957.        RETURN
  958.        END
  959.  
  960.        SUBROUTINE ptkf_writeterminal(windid, str)
  961. C /*
  962. C ** \parambegin
  963. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  964. C ** \param{CHARACTER*(*)}{str}{string to write to window}{IN}
  965. C ** \paramend
  966. C ** \blurb{This function writes a character string to the current line
  967. C ** of the TERMINAL window. A new line is started when the end of the
  968. C ** current line is reached.}
  969. C */
  970.        INTEGER windid
  971.        CHARACTER*(*) str
  972.        CHARACTER*255 inbuf
  973.        external ptk_writeterminal !$PRAGMA C(ptk_writeterminal)
  974.  
  975.        inbuf = str//'\0'
  976.        call ptk_writeterminal(%val(windid), inbuf)
  977.  
  978.        RETURN
  979.        END
  980.  
  981.        SUBROUTINE ptkf_writelnterminal(windid, str)
  982. C /*
  983. C ** \parambegin
  984. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  985. C ** \param{CHARACTER*(*)}{str}{string to write to window}{IN}
  986. C ** \paramend
  987. C ** \blurb{This function writes a character string to the current line
  988. C ** of the TERMINAL window. A new line is started when the end of the current
  989. C ** line is reached and at the next call to a TERMINAL write function.}
  990. C */
  991.        INTEGER windid
  992.        CHARACTER*(*) str
  993.        CHARACTER*255 inbuf
  994.        external ptk_writelnterminal !$PRAGMA C(ptk_writelnterminal)
  995.  
  996.        inbuf = str//'\0'
  997.        call ptk_writelnterminal(%val(windid), inbuf)
  998.  
  999.        RETURN
  1000.        END
  1001.  
  1002.        SUBROUTINE ptkf_clearterminal(windid)
  1003. C /*
  1004. C ** \parambegin
  1005. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1006. C ** \paramend
  1007. C ** \blurb{This function empties the structure containing all the text
  1008. C ** written to the TERMINAL window.}
  1009. C */
  1010.        INTEGER windid
  1011.        external ptk_clearterminal !$PRAGMA C(ptk_clearterminal)
  1012.  
  1013.        call ptk_clearterminal(%val(windid))
  1014.  
  1015.        RETURN
  1016.        END
  1017.  
  1018.        SUBROUTINE ptkf_writeintterminal(windid, number)
  1019. C /*
  1020. C ** \parambegin
  1021. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1022. C ** \param{INTEGER}{number}{integer to write to window}{IN}
  1023. C ** \paramend
  1024. C ** \blurb{This function writes an integer to a TERMINAL window.}
  1025. C */
  1026.        INTEGER windid, number
  1027.        external ptk_writeintterminal !$PRAGMA C(ptk_writeintterminal)
  1028.  
  1029.        call ptk_writeintterminal(%val(windid), %val(number))
  1030.  
  1031.        RETURN
  1032.        END
  1033.  
  1034.        SUBROUTINE ptkf_writefloatterminal(windid, number)
  1035. C /*
  1036. C ** \parambegin
  1037. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1038. C ** \param{REAL}{number}{float number to write to window}{IN}
  1039. C ** \paramend
  1040. C ** \blurb{This function writes a floating point number to a TERMINAL window.}
  1041. C */
  1042.        INTEGER windid
  1043.        REAL number
  1044.        REAL*8 dpnumber
  1045.        external ptk_writefloatterminal 
  1046. & !$PRAGMA C(ptk_writefloatterminal)
  1047.  
  1048.        dpnumber = number
  1049.        call ptk_writefloatterminal(%val(windid), %val(dpnumber))
  1050.  
  1051.        RETURN
  1052.        END
  1053.  
  1054.        SUBROUTINE ptkf_setterminalfloatformat(windid, rformat)
  1055. C /*
  1056. C ** \parambegin
  1057. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1058. C ** \param{CHARACTER*(*)}{rformat}{string giving C-type float number output style}{IN}
  1059. C ** \paramend
  1060. C ** \blurb{This function sets the format for writing floating-point numbers
  1061. C ** to a TERMINAL window. The format used is the same syntax as in the
  1062. C ** C language.}
  1063. C */
  1064.        INTEGER windid
  1065.        CHARACTER*(*) rformat
  1066.        CHARACTER*255 inbuf
  1067.        external ptk_setterminalfloatformat 
  1068. & !$PRAGMA C(ptk_setterminalfloatformat)
  1069.  
  1070.        inbuf = rformat//'\0'
  1071.        call ptk_setterminalfloatformat(%val(windid), inbuf)
  1072.  
  1073.        RETURN
  1074.        END
  1075.  
  1076.        SUBROUTINE ptkf_inqterminalfloatformat(windid, size, totalsize, 
  1077. & rformat, err)
  1078. C /*
  1079. C ** \parambegin
  1080. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1081. C ** \param{INTEGER}{size}{size of buffer, in bytes, as allocated by application}{IN}
  1082. C ** \param{INTEGER}{totalsize}{actual size of buffer}{IN}
  1083. C ** \param{CHARACTER*(*)}{rformat}{string giving C-type float number output style}{IN}
  1084. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1085. C ** \paramend
  1086. C ** \blurb{This function may be used to obtain the floating-point used
  1087. C ** for writing floating-point numbers to a TERMINAL window.}
  1088. C */
  1089.        INTEGER windid, size, totalsize
  1090.        CHARACTER*(*) rformat
  1091.        INTEGER err
  1092.        external ptk_inqterminalfloatformat 
  1093. & !$PRAGMA C(ptk_inqterminalfloatformat)
  1094.  
  1095.        call ptk_inqterminalfloatformat(%val(windid), %val(size), 
  1096. & totalsize, rformat, err)
  1097.  
  1098.        RETURN
  1099.        END
  1100.  
  1101.        SUBROUTINE ptkf_inqterminalstructid(windid, termwinstid, err)
  1102. C /*
  1103. C ** \parambegin
  1104. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1105. C ** \param{INTEGER}{termwinstid}{text structure identifier}{OUT}
  1106. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1107. C ** \paramend
  1108. C ** \blurb{This function may be used to obtain the identifier of the
  1109. C ** structure used to display the text written to a TERMINAL window.}
  1110. C */
  1111.        INTEGER windid, termwinstid, err
  1112.        external ptk_inqterminalstructid 
  1113. & !$PRAGMA C(ptk_inqterminalstructid)
  1114.  
  1115.        call ptk_inqterminalstructid(%val(windid), termwinstid, err)
  1116.  
  1117.        RETURN
  1118.        END
  1119.  
  1120.        SUBROUTINE ptkf_inqterminaldata(windid, numlines, numcolumns,
  1121. & txfont, txcolour, err)
  1122. C /*
  1123. C ** \parambegin
  1124. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1125. C ** \param{INTEGER}{numlines}{number of lines in window}{OUT}
  1126. C ** \param{INTEGER}{numcolmns}{number of columns in window}{OUT}
  1127. C ** \param{INTEGER}{txfont}{text font}{OUT}
  1128. C ** \param{INTEGER}{txcolour}{text colour}{OUT}
  1129. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1130. C ** \paramend
  1131. C ** \blurb{This function may be used to obtain the number of lines
  1132. C ** displayed in a TERMINAL window and the number of characters in a line.
  1133. C ** Also the text font and colour used are returned in {\tt txfont} and
  1134. C ** {\tt txcolour}.}
  1135. C */
  1136.        INTEGER windid, numlines, numcolumns, txfont, txcolour, err
  1137.        external ptk_inqterminaldata !$PRAGMA C(ptk_inqterminaldata)
  1138.  
  1139.        call ptk_inqterminaldata(%val(windid), numlines, numcolumns,
  1140. & txfont, txcolour, err)
  1141.  
  1142.        RETURN
  1143.        END
  1144.  
  1145.        SUBROUTINE ptkf_scrollterminal(windid, scrolldir, numlines)
  1146. C /*
  1147. C ** \parambegin
  1148. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1149. C ** \param{INTEGER}{scrolldir}{scroll direction (up or down)}{IN}
  1150. C ** \param{INTEGER}{numlines}{number of lines to scroll by}{IN}
  1151. C ** \paramend
  1152. C ** \blurb{This function scrolls the contents of the TERMINAL window
  1153. C ** either UP or DOWN by {\tt numlines}.}
  1154. C */
  1155.        INTEGER windid, scrolldir, numlines
  1156.        external ptk_scrollterminal !$PRAGMA C(ptk_scrollterminal)
  1157.  
  1158.        call ptk_scrollterminal(%val(windid), %val(scrolldir), 
  1159. & %val(numlines))
  1160.  
  1161.        RETURN
  1162.        END
  1163.  
  1164. C topology viewing functions 
  1165.  
  1166.        SUBROUTINE ptkf_settopologyviewarea(windid, viewarea)
  1167. C /*
  1168. C ** \parambegin
  1169. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1170. C ** \param{REAL}{viewarea(4)}{area of topology to view}{IN}
  1171. C ** \paramend 
  1172. C ** \blurb{This function sets the viewing area of a topology diagram posted
  1173. C ** to a TOPOLOGY window. The area is defined in the range [0, 1].}
  1174. C */
  1175.        INTEGER windid
  1176.        REAL viewarea(4)
  1177.        external ptk_settopologyviewarea 
  1178. & !$PRAGMA C(ptk_settopologyviewarea)
  1179.  
  1180.        call ptk_settopologyviewarea(%val(windid), viewarea)
  1181.  
  1182.        RETURN
  1183.        END
  1184.  
  1185.        SUBROUTINE ptkf_inqtopologyviewarea(windid, viewarea, err)
  1186. C /*
  1187. C ** \parambegin
  1188. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1189. C ** \param{REAL}{viewarea(4)}{area of topology to view}{OUT}
  1190. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1191. C ** \paramend 
  1192. C ** \blurb{This function may be used to obtain the viewing area
  1193. C ** of a topology diagram posted to a TOPOLOGY window.}
  1194. C */
  1195.        INTEGER windid
  1196.        REAL viewarea(4)
  1197.        INTEGER err
  1198.        external ptk_inqtopologyviewarea 
  1199. & !$PRAGMA C(ptk_inqtopologyviewarea)
  1200.  
  1201.        call ptk_inqtopologyviewarea(%val(windid), viewarea, err)
  1202.  
  1203.        RETURN
  1204.        END
  1205.  
  1206. C structure content viewing functions 
  1207.  
  1208.        SUBROUTINE ptkf_setcontentviewrange(windid, range1, range2)
  1209. C /*
  1210. C ** \parambegin
  1211. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1212. C ** \param{INTEGER}{range1}{start element number}{IN}
  1213. C ** \param{INTEGER}{range2}{end element number}{IN}
  1214. C ** \paramend 
  1215. C ** \blurb{This function sets the range of elements of a structure
  1216. C ** content diagram to view in a CONTENT window.}
  1217. C */
  1218.        INTEGER windid, range1, range2
  1219.        external ptk_setcontentviewrange 
  1220. & !$PRAGMA C(ptk_setcontentviewrange)
  1221.  
  1222.        call ptk_setcontentviewrange(%val(windid), %val(range1), 
  1223. & %val(range2))
  1224.  
  1225.        RETURN
  1226.        END
  1227.  
  1228.        SUBROUTINE ptkf_inqcontentviewrange(windid, range1, range2, err)
  1229. C /*
  1230. C ** \parambegin
  1231. C ** \param{INTEGER}{windid}{terminal window identifier}{IN}
  1232. C ** \param{INTEGER}{range1}{element number}{IN}
  1233. C ** \param{INTEGER}{range2}{element number}{IN}
  1234. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1235. C ** \paramend
  1236. C ** \blurb{This function may be used to obtain the viewing range of
  1237. C ** a structure content diagram which is posted to a CONTENT window.}
  1238. C */
  1239.        INTEGER windid, range1, range2, err
  1240.        external ptk_inqcontentviewrange
  1241. & !$PRAGMA C(ptk_inqcontentviewrange)
  1242.  
  1243.        call ptk_inqcontentviewrange(%val(windid), range1, 
  1244. & range2, err)
  1245.  
  1246.        RETURN
  1247.        END
  1248.  
  1249. C camera functions 
  1250.  
  1251.        SUBROUTINE ptkf_rotatecameraposition(windid, spinangle)
  1252. C /*
  1253. C ** \parambegin
  1254. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1255. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1256. C ** \paramend 
  1257. C ** \blurb{This function rotates the camera position in a circle centred
  1258. C ** at the point of interest and about the axis defined by the function
  1259. C ** {\tt ptk\_setpositionaxis}. The amount of rotation is {\tt angle}
  1260. C ** degrees and the function is useful for rotating around an object.}
  1261. C */
  1262.        INTEGER windid
  1263.        REAL spinangle
  1264.        REAL*8 dpspinangle
  1265.        external ptk_rotatecameraposition 
  1266. & !$PRAGMA C(ptk_rotatecameraposition)
  1267.  
  1268.        dpspinangle = spinangle
  1269.        call ptk_rotatecameraposition(%val(windid), %val(dpspinangle))
  1270.  
  1271.        RETURN
  1272.        END
  1273.  
  1274.        SUBROUTINE ptkf_setpositionaxis(windid, axis)
  1275. C /*
  1276. C ** \parambegin
  1277. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1278. C ** \param{REAL}{axis(3)}{axis of rotation}{IN}
  1279. C ** \paramend 
  1280. C ** \blurb{This function sets the axis of rotation for rotating 
  1281. C ** the camera position using the function {\tt ptk\_rotatecameraposition}.}
  1282. C */
  1283.        INTEGER windid
  1284.        REAL axis(3)
  1285.        external ptk_setpositionaxis !$PRAGMA C(ptk_setpositionaxis)
  1286.  
  1287.        call ptk_setpositionaxis(%val(windid), axis)
  1288.  
  1289.        RETURN
  1290.        END
  1291.  
  1292.        SUBROUTINE ptkf_setptinterestaxis(windid, axis)
  1293. C /*
  1294. C ** \parambegin
  1295. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1296. C ** \param{REAL}{axis(3)}{axis of rotation}{IN}
  1297. C ** \paramend 
  1298. C ** \blurb{This function sets the axis of rotation for rotating 
  1299. C ** the camera point of interest using the function
  1300. C ** {\tt ptk\_rotatecameraptinterest}.}
  1301. C */
  1302.        INTEGER windid
  1303.        REAL axis(3)
  1304.        external ptk_setptinterestaxis !$PRAGMA C(ptk_setptinterestaxis)
  1305.  
  1306.        call ptk_setptinterestaxis(%val(windid), axis)
  1307.  
  1308.        RETURN
  1309.        END
  1310.  
  1311.        SUBROUTINE ptkf_scaleviewwindow(windid, scalefactor)
  1312. C /*
  1313. C ** \parambegin
  1314. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1315. C ** \param{REAL}{scalefactor}{scale factor}{IN}
  1316. C ** \paramend 
  1317. C ** \blurb{This function scales the view window uniformly
  1318. C ** by {\tt scalefactor}. A scalefactor in the range [0, 1] will
  1319. C ** scale down the view window and create a zoom-in effect.
  1320. C ** A scalefactor greater than 1.0 will give a zoom-out effect.}
  1321. C */
  1322.        INTEGER windid
  1323.        REAL scalefactor
  1324.        REAL*8 dpscalefactor
  1325.        external ptk_scaleviewwindow !$PRAGMA C(ptk_scaleviewwindow)
  1326.  
  1327.        dpscalefactor = scalefactor
  1328.        call ptk_scaleviewwindow(%val(windid), %val(dpscalefactor))
  1329.  
  1330.        RETURN
  1331.        END
  1332.  
  1333.        SUBROUTINE ptkf_rotatecameraptinterest(windid, swivelangle)
  1334. C /*
  1335. C ** \parambegin
  1336. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1337. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1338. C ** \paramend 
  1339. C ** \blurb{This function rotates the camera point of interest in a circle 
  1340. C ** centred at the camera position and about the axis defined by the function
  1341. C ** {\tt ptk\_setptinterestaxis}. The amount of rotation is {\tt angle}
  1342. C ** degrees and the function is useful for panning around a scene.}
  1343. C */
  1344.        INTEGER windid
  1345.        REAL swivelangle
  1346.        REAL*8 dpswivelangle
  1347.        external ptk_rotatecameraptinterest 
  1348. & !$PRAGMA C(ptk_rotatecameraptinterest)
  1349.  
  1350.        dpswivelangle = swivelangle
  1351.        call ptk_rotatecameraptinterest(%val(windid), 
  1352. & %val(dpswivelangle))
  1353.  
  1354.        RETURN
  1355.        END
  1356.  
  1357.        SUBROUTINE ptkf_rotatecameraupvector(windid, twistangle)
  1358. C /*
  1359. C ** \parambegin
  1360. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1361. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1362. C ** \paramend 
  1363. C ** \blurb{This function rotates the camera up vector 
  1364. C ** about the axis joining the camera position to the point of interest by
  1365. C ** {\tt angle} degrees.}
  1366. C */
  1367.        INTEGER windid
  1368.        REAL twistangle
  1369.        REAL*8 dptwistangle
  1370.        external ptk_rotatecameraupvector 
  1371. & !$PRAGMA C(ptk_rotatecameraupvector)
  1372.  
  1373.        dptwistangle = twistangle
  1374.        call ptk_rotatecameraupvector(%val(windid), %val(dptwistangle))
  1375.  
  1376.        RETURN
  1377.        END
  1378.  
  1379.        SUBROUTINE ptkf_rotatepositionxaxis(windid, angle)
  1380. C /*
  1381. C ** \parambegin
  1382. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1383. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1384. C ** \paramend 
  1385. C ** \blurb{This function rotates the camera position in a circle centred
  1386. C ** at the point of interest and about the y axis of a right-handed
  1387. C ** coordinate system whose z axis is defined by the camera position
  1388. C ** point of interest.}
  1389. C */
  1390.        INTEGER windid
  1391.        REAL angle
  1392.        REAL*8 dpangle
  1393.        external ptk_rotatepositionxaxis
  1394. & !$PRAGMA C(ptk_rotatepositionxaxis)
  1395.  
  1396.        dpangle = angle
  1397.        call ptk_rotatepositionxaxis(%val(windid), %val(dpangle))
  1398.  
  1399.        RETURN
  1400.        END
  1401.  
  1402.        SUBROUTINE ptkf_rotatepositionyaxis(windid, angle)
  1403. C /*
  1404. C ** \parambegin
  1405. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1406. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1407. C ** \paramend 
  1408. C ** \blurb{This function rotates the camera position in a circle centred
  1409. C ** at the point of interest and about the x axis of a right-handed
  1410. C ** coordinate system whose z axis is defined by the camera position
  1411. C ** point of interest.}
  1412. C */
  1413.        INTEGER windid
  1414.        REAL angle
  1415.        REAL*8 dpangle
  1416.        external ptk_rotatepositionyaxis
  1417. & !$PRAGMA C(ptk_rotatepositionyaxis)
  1418.  
  1419.        dpangle = angle
  1420.        call ptk_rotatepositionyaxis(%val(windid), %val(dpangle))
  1421.  
  1422.        RETURN
  1423.        END
  1424.  
  1425.        SUBROUTINE ptkf_rotateptinterestxaxis(windid, angle)
  1426. C /*
  1427. C ** \parambegin
  1428. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1429. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1430. C ** \paramend 
  1431. C ** \blurb{This function rotates the camera point of interest
  1432. C ** in a circle centred
  1433. C ** at the camera position and about the y axis of a right-handed
  1434. C ** coordinate system whose z axis is defined by the camera position
  1435. C ** point of interest.}
  1436. C */
  1437.        INTEGER windid
  1438.        REAL angle
  1439.        REAL*8 dpangle
  1440.        external ptk_rotateptinterestxaxis
  1441. & !$PRAGMA C(ptk_rotateptinterestxaxis)
  1442.  
  1443.        dpangle = angle
  1444.        call ptk_rotateptinterestxaxis(%val(windid), %val(dpangle))
  1445.  
  1446.        RETURN
  1447.        END
  1448.  
  1449.        SUBROUTINE ptkf_rotateptinterestyaxis(windid, angle)
  1450. C /*
  1451. C ** \parambegin
  1452. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1453. C ** \param{REAL}{angle}{rotation angle in degrees}{IN}
  1454. C ** \paramend 
  1455. C ** \blurb{This function rotates the camera point of interest
  1456. C ** in a circle centred
  1457. C ** at the camera position and about the x axis of a right-handed
  1458. C ** coordinate system whose z axis is defined by the camera position
  1459. C ** point of interest.}
  1460. C */
  1461.        INTEGER windid
  1462.        REAL angle
  1463.        REAL*8 dpangle
  1464.        external ptk_rotateptinterestyaxis
  1465. & !$PRAGMA C(ptk_rotateptinterestyaxis)
  1466.  
  1467.        dpangle = angle
  1468.        call ptk_rotateptinterestyaxis(%val(windid), %val(dpangle))
  1469.  
  1470.        RETURN
  1471.        END
  1472.  
  1473.        SUBROUTINE ptkf_shiftcamera(windid, shift)
  1474. C /*
  1475. C ** \parambegin
  1476. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1477. C ** \param{REAL}{shift(3)}{shift factor}{IN}
  1478. C ** \paramend 
  1479. C ** \blurb{This function shifts the camera point of interest
  1480. C ** and camera position about the axes of a right-handed
  1481. C ** coordinate system whose z axis is defined by the camera position 
  1482. C ** and point of interest.}
  1483. C */
  1484.        INTEGER windid
  1485.        REAL shift(3)
  1486.        external ptk_shiftcamera !$PRAGMA C(ptk_shiftcamera)
  1487.  
  1488.        call ptk_shiftcamera(%val(windid), shift)
  1489.  
  1490.        RETURN
  1491.        END
  1492.  
  1493.        SUBROUTINE ptkf_setcameraposition(windid, position)
  1494. C /*
  1495. C ** \parambegin
  1496. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1497. C ** \param{REAL}{position(3)}{camera position}{IN}
  1498. C ** \paramend 
  1499. C ** \blurb{This function sets the camera position to {\tt position}
  1500. C ** which is given in World Coordinates.}
  1501. C */
  1502.        INTEGER windid
  1503.        REAL position(3)
  1504.        external ptk_setcameraposition !$PRAGMA C(ptk_setcameraposition)
  1505.  
  1506.        call ptk_setcameraposition(%val(windid), position)
  1507.  
  1508.        RETURN
  1509.        END
  1510.  
  1511.        SUBROUTINE ptkf_setcameraptinterest(windid, ptinterest)
  1512. C /*
  1513. C ** \parambegin
  1514. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1515. C ** \param{REAL}{ptinterest(3)}{point of interest}{IN}
  1516. C ** \paramend 
  1517. C ** \blurb{This function sets the camera point of interest to
  1518. C ** {\tt ptinterest} which is given in World Corrdinates.}
  1519. C */
  1520.        INTEGER windid
  1521.        REAL ptinterest(3)
  1522.        external ptk_setcameraptinterest 
  1523. & !$PRAGMA C(ptk_setcameraptinterest)
  1524.  
  1525.        call ptk_setcameraptinterest(%val(windid), ptinterest)
  1526.  
  1527.        RETURN
  1528.        END
  1529.  
  1530.        SUBROUTINE ptkf_setcameraprojtype(windid, proj)
  1531. C /*
  1532. C ** \parambegin
  1533. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1534. C ** \param{INTEGER}{proj}{camera projection type}{IN}
  1535. C ** \paramend 
  1536. C ** \blurb{This function sets the projection type of the view given by the
  1537. C ** camera to PARALLEL or PERSPECTIVE. The default is PARALLEL.}
  1538. C */
  1539.        INTEGER windid, proj
  1540.        external ptk_setcameraprojtype !$PRAGMA C(ptk_setcameraprojtype)
  1541.  
  1542.        call ptk_setcameraprojtype(%val(windid), %val(proj))
  1543.  
  1544.        RETURN
  1545.        END
  1546.  
  1547.        SUBROUTINE ptkf_setcamerastate(windid, cameraswitch)
  1548. C /*
  1549. C ** \parambegin
  1550. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1551. C ** \param{INTEGER}{cameraswitch}{camera on or off}{IN}
  1552. C ** \paramend 
  1553. C ** \blurb{This function sets the camera of the window {\tt windid}
  1554. C ** to ON or OFF. The default is ON.}
  1555. C */
  1556.        INTEGER windid
  1557.        LOGICAL cameraswitch
  1558.        LOGICAL*1 fcameraswitch
  1559.        external ptk_setcamerastate !$PRAGMA C(ptk_setcamerastate)
  1560.  
  1561.        fcameraswitch = cameraswitch
  1562.        call ptk_setcamerastate(%val(windid), %val(fcameraswitch))
  1563.  
  1564.        RETURN
  1565.        END
  1566.  
  1567.        SUBROUTINE ptkf_setcameraworld(windid, num, stids)
  1568. C /*
  1569. C ** \parambegin
  1570. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1571. C ** \param{INTEGER}{stids(*)}{structure identifier list}{IN}
  1572. C ** \paramend 
  1573. C ** \blurb{This function sets the view volume of the camera so 
  1574. C ** that it contains the combined bounding box of all the 
  1575. C ** structures and structure networks in {\tt stids}.}
  1576. C */
  1577.        INTEGER windid, num, stids(num)
  1578.        external ptkc_setcameraworld !$PRAGMA C(ptkc_setcameraworld)
  1579.  
  1580.        call ptkc_setcameraworld(%val(windid), %val(num), stids)
  1581.  
  1582.        RETURN
  1583.        END
  1584.  
  1585.        SUBROUTINE ptkf_setcameralimits(windid, limits, adjust)
  1586. C /*
  1587. C ** \parambegin
  1588. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1589. C ** \param{REAL}{limits(6)}{camera viewing limits in WC}{IN}
  1590. C ** \param{LOGICAL}{adjust}{adjust given limits}{IN}
  1591. C ** \paramend 
  1592. C ** \blurb{This function sets the view volume of the camera
  1593. C ** to the specified bounding box given in World Coordinates. If 
  1594. C ** {\tt adjust} is set to TRUE then the bounding box will be adjusted 
  1595. C ** to be the bounding box of a sphere which encloses the original box.}
  1596. C */
  1597.        INTEGER windid
  1598.        REAL limits(6)
  1599.        LOGICAL adjust
  1600.        LOGICAL*1 fadjust
  1601.        external ptk_setcameralimits !$PRAGMA C(ptk_setcameralimits)
  1602.  
  1603.        fadjust = adjust
  1604.        call ptk_setcameralimits(%val(windid), limits, %val(fadjust))
  1605.  
  1606.        RETURN
  1607.        END
  1608.  
  1609.        SUBROUTINE ptkf_resetcamera(windid)
  1610. C /*
  1611. C ** \parambegin
  1612. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1613. C ** \paramend 
  1614. C ** \blurb{This function resets the camera variables to their default
  1615. C ** values. The camera view volume is left unchanged.}
  1616. C */
  1617.        INTEGER windid
  1618.        external ptk_resetcamera !$PRAGMA C(ptk_resetcamera)
  1619.  
  1620.        call ptk_resetcamera(%val(windid))
  1621.  
  1622.        RETURN
  1623.        END
  1624.  
  1625.        SUBROUTINE ptkf_inqcameraposition(windid, position, err)
  1626. C /*
  1627. C ** \parambegin
  1628. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1629. C ** \param{REAL}{position(3)}{camera position}{OUT}
  1630. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1631. C ** \paramend
  1632. C ** \blurb{This function may be used to obtain the camera position in
  1633. C ** World Coordinates.}
  1634. C */
  1635.        INTEGER windid
  1636.        REAL position(3)
  1637.        INTEGER err
  1638.        external ptk_inqcameraposition !$PRAGMA C(ptk_inqcameraposition)
  1639.  
  1640.        call ptk_inqcameraposition(%val(windid), position, err)
  1641.  
  1642.        RETURN
  1643.        END
  1644.  
  1645.        SUBROUTINE ptkf_inqcameraptinterest(windid, ptinterest, err)
  1646. C /*
  1647. C ** \parambegin
  1648. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1649. C ** \param{REAL}{ptinterest(3)}{camera point of interest}{OUT}
  1650. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1651. C ** \paramend
  1652. C ** \blurb{This function may be used to obtain the camera point of interest
  1653. C ** in World Coordinates.}
  1654. C */
  1655.        INTEGER windid
  1656.        REAL ptinterest(3)
  1657.        INTEGER err
  1658.        external ptk_inqcameraptinterest 
  1659. & !$PRAGMA C(ptk_inqcameraptinterest)
  1660.  
  1661.        call ptk_inqcameraptinterest(%val(windid), ptinterest, err)
  1662.  
  1663.        RETURN
  1664.        END
  1665.  
  1666.        SUBROUTINE ptkf_inqcameraprojtype(windid, projtype, err)
  1667. C /*
  1668. C ** \parambegin
  1669. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1670. C ** \param{INTEGER}{projtype}{camera projection type}{OUT}
  1671. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1672. C ** \paramend
  1673. C ** \blurb{This function may be used to obtain the camera view projection
  1674. C ** type which is either PARALLEL or PERSPECTIVE.}
  1675. C */
  1676.        INTEGER windid, projtype, err
  1677.        external ptk_inqcameraprojtype 
  1678. & !$PRAGMA C(ptk_inqcameraprojtype)
  1679.  
  1680.        call ptk_inqcameraprojtype(%val(windid), projtype, err)
  1681.  
  1682.        RETURN
  1683.        END
  1684.  
  1685.        SUBROUTINE ptkf_inqcamerastate(windid, switch, err)
  1686. C /*
  1687. C ** \parambegin
  1688. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1689. C ** \param{INTEGER}{cameraswitch}{camera ON/OFF switch}{OUT}
  1690. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1691. C ** \paramend
  1692. C ** \blurb{This function may be used to obtain the camera state which is
  1693. C ** either ON or OFF.}
  1694. C */
  1695.        INTEGER windid, switch, err
  1696.        external ptk_inqcamerastate !$PRAGMA C(ptk_inqcamerastate)
  1697.  
  1698.        call ptk_inqcamerastate(%val(windid), switch, err)
  1699.  
  1700.        RETURN
  1701.        END
  1702.  
  1703.        SUBROUTINE ptkf_inqcameralimits(windid, limits, err)
  1704. C /*
  1705. C ** \parambegin
  1706. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1707. C ** \param{REAL}{limits(6)}{camera world limits}{OUT}
  1708. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1709. C ** \paramend
  1710. C ** \blurb{This function may be used to obtain the camera view volume.
  1711. C ** This defines the volume of a scene that the camera knows about
  1712. C ** and is returned in World Coordinates.}
  1713. C */
  1714.        INTEGER windid
  1715.        REAL limits(6)
  1716.        INTEGER err
  1717.        external ptk_inqcameralimits !$PRAGMA C(ptk_inqcameralimits)
  1718.  
  1719.        call ptk_inqcameralimits(%val(windid), limits, err)
  1720.  
  1721.        RETURN
  1722.        END
  1723.  
  1724.        SUBROUTINE ptkf_inqpositionaxis(windid, axis, err)
  1725. C /*
  1726. C ** \parambegin
  1727. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1728. C ** \param{REAL}{axis(3)}{camera position axis of rotation}{OUT}
  1729. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1730. C ** \paramend
  1731. C ** \blurb{This function may be used to obtain the axis of rotation
  1732. C ** which is used to rotate the camera position in the function
  1733. C ** {\tt ptk\_rotatecameraposition}.}
  1734. C */
  1735.        INTEGER windid
  1736.        REAL axis(3)
  1737.        INTEGER err
  1738.        external ptk_inqpositionaxis !$PRAGMA C(ptk_inqpositionaxis)
  1739.  
  1740.        call ptk_inqpositionaxis(%val(windid), axis, err)
  1741.  
  1742.        RETURN
  1743.        END
  1744.  
  1745.        SUBROUTINE ptkf_inqptinterestaxis(windid, axis, err)
  1746. C /*
  1747. C ** \parambegin
  1748. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1749. C ** \param{REAL}{axis(3)}{camera point of interest axis of rotation}{OUT}
  1750. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1751. C ** \paramend
  1752. C ** \blurb{This function may be used to obtain the axis of rotation
  1753. C ** which is used to rotate the camera point of interest in the function
  1754. C ** {\tt ptk\_rotatecameraptinterest}.}
  1755. C */
  1756.        INTEGER windid
  1757.        REAL axis(3)
  1758.        INTEGER err
  1759.        external ptk_inqptinterestaxis 
  1760. & !$PRAGMA C(ptk_inqptinterestaxis)
  1761.  
  1762.        call ptk_inqptinterestaxis(%val(windid), axis, err)
  1763.  
  1764.        RETURN
  1765.        END
  1766.  
  1767.     SUBROUTINE ptkf_inqwindowviewrep(windid, 
  1768. & vwormt, vwmpmt, vwcplm, xyclpi, bclipi, fclipi, err)
  1769. C /*
  1770. C ** \parambegin
  1771. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1772. C ** \param{REAL}{vwormt(4, 4)}{view orientation matrix}{OUT}
  1773. C ** \param{REAL}{vwmpmt(4, 4)}{view mapping matrix}{OUT}
  1774. C ** \param{REAL}{vwcplm(6)}{view clipping limits}{OUT}
  1775. C ** \param{INTEGER}{xyclpi}{x-y clipping indicator}{OUT}
  1776. C ** \param{INTEGER}{bclipi}{back clipping indicator}{OUT}
  1777. C ** \param{INTEGER}{fclipi}{front clipping indicator}{OUT}
  1778. C ** \param{INTEGER}{err}{error indicator}{OUT}
  1779. C ** \paramend
  1780. C ** \blurb{This function may be used to obtain the viewing parameters
  1781. C ** which are used to set the window view when the camera is switched
  1782. C ** OFF.}
  1783. C */
  1784.          INTEGER windid      !        window identifier
  1785.          REAL vwormt(4,4)  !        view orientation matrix
  1786.          REAL vwmpmt(4,4)  !        view mapping matrix
  1787.          REAL vwcplm(6)    !        view clipping limits (NPC)
  1788.                           !        xmin,xmax,ymin,ymax,zmin,zmax
  1789.          INTEGER xyclpi    !        x-y clipping indicator (PNCLIP,PCLIP)
  1790.          INTEGER bclipi    !        back clipping indicator (PNCLIP,PCLIP)
  1791.          INTEGER fclipi    !        front clipping indicator (PNCLIP,PCLIP)
  1792.         INTEGER err
  1793.     EXTERNAL ptkc_inqwindowviewrep 
  1794. & !$PRAGMA C(ptkc_inqwindowviewrep)
  1795.  
  1796.     CALL ptkc_inqwindowviewrep(%val(windid),
  1797. & vwormt, vwmpmt, vwcplm, xyclpi, bclipi, fclipi, err)
  1798.  
  1799.     RETURN
  1800.     END
  1801.  
  1802. C viewing functions 
  1803.  
  1804.        SUBROUTINE ptkf_setvieworientation3(windid, vrp, vpn, vup, error)
  1805. C /*
  1806. C ** \parambegin
  1807. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1808. C ** \param{REAL}{vrp(3)}{view reference point}{IN}
  1809. C ** \param{REAL}{vpn(3)}{view plane normal}{IN}
  1810. C ** \param{REAL}{vup(3)}{view up vector}{IN}
  1811. C ** \param{INTEGER}{error}{error indicator}{OUT}
  1812. C ** \paramend 
  1813. C ** \blurb{This function sets the window view orientation values. 
  1814. C ** The camera must be switched OFF for these values to be set.}
  1815. C */
  1816.        INTEGER windid
  1817.        REAL vrp(3), vpn(3), vup(3)
  1818.        INTEGER error
  1819.        external ptk_setvieworientation3 
  1820. & !$PRAGMA C(ptk_setvieworientation3)
  1821.  
  1822.        call ptk_setvieworientation3(%val(windid), vrp, vpn, vup, error)
  1823.  
  1824.        RETURN
  1825.        END
  1826.  
  1827.        SUBROUTINE ptkf_setviewmapping3(windid, window, viewport, proj, 
  1828. & prp, viewplane, backplane, frontplane, error)
  1829. C /*
  1830. C ** \parambegin
  1831. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1832. C ** \param{REAL}{window(4)}{view window}{IN}
  1833. C ** \param{REAL}{viewport(6)}{projection viewport}{IN}
  1834. C ** \param{INTEGER}{proj}{projection type}{IN}
  1835. C ** \param{REAL}{prp(3)}{projection reference point}{IN}
  1836. C ** \param{REAL}{viewplane}{view plane distance}{IN}
  1837. C ** \param{REAL}{backplane}{back plane distance}{IN}
  1838. C ** \param{REAL}{frontplane}{front plane distance}{IN}
  1839. C ** \param{INTEGER}{error}{error indicator}{OUT}
  1840. C ** \paramend 
  1841. C ** \blurb{This function sets the window view mapping values.
  1842. C ** The camera must be switched OFF for these values to be set.
  1843. C ** The largest square within the window is defined to be the
  1844. C ** device coordinates area which the view maps onto.}
  1845. C */
  1846.        INTEGER windid
  1847.        REAL window(4), viewport(6)
  1848.        INTEGER proj
  1849.        REAL prp(3), viewplane, backplane, frontplane
  1850.        INTEGER error
  1851.        REAL*8 dpviewplane, dpbackplane, dpfrontplane
  1852.        external ptk_setviewmapping3 !$PRAGMA C(ptk_setviewmapping3)
  1853.  
  1854.        dpviewplane = viewplane
  1855.        dpbackplane = backplane
  1856.        dpfrontplane = frontplane
  1857.        call ptk_setviewmapping3(%val(windid), window, viewport, 
  1858. & %val(proj), prp, %val(dpviewplane), %val(dpbackplane), 
  1859. & %val(dpfrontplane), error)
  1860.  
  1861.        RETURN
  1862.        END
  1863.  
  1864.        SUBROUTINE ptkf_setviewclipping3(windid, cliplims, clipxy,
  1865. & clipback, clipfront)
  1866. C /*
  1867. C ** \parambegin
  1868. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1869. C ** \param{REAL}{cliplims(6)}{view clipping limits}{IN}
  1870. C ** \param{INTEGER}{clipxy}{x-y clipping indicator}{IN}
  1871. C ** \param{INTEGER}{clipback}{back plane clipping indicator}{IN}
  1872. C ** \param{INTEGER}{clipfront}{front plane clipping indicator}{IN}
  1873. C ** \paramend 
  1874. C ** \blurb{This function sets the window view clipping values. 
  1875. C ** The camera must be switched OFF for these values to be set.}
  1876. C */
  1877.        INTEGER windid
  1878.        REAL cliplims(6)
  1879.        INTEGER clipxy, clipback, clipfront
  1880.        external ptk_setviewclipping3 !$PRAGMA C(ptk_setviewclipping3)
  1881.  
  1882.        call ptk_setviewclipping3(%val(windid), cliplims, %val(clipxy),
  1883. & %val(clipback), %val(clipfront))
  1884.  
  1885.        RETURN
  1886.        END
  1887.  
  1888. C window type functions 
  1889.  
  1890.        SUBROUTINE ptkf_setwindowtype(windid, windtype)
  1891. C /*
  1892. C ** \parambegin
  1893. C ** \param{INTEGER}{windid}{window identifier}{IN}
  1894. C ** \param{INTEGER}{windtype}{window type}{IN}
  1895. C ** \paramend 
  1896. C ** \blurb{This function sets the type of a window to one of
  1897. C ** STRUCT, TOPOLOGY, CONTENT and TERMINAL. The default window type is
  1898. C ** STRUCT. All items are unposted from the window before the type
  1899. C ** is set.}
  1900. C */
  1901.        INTEGER windid, windtype
  1902.        external ptk_setwindowtype !$PRAGMA C(ptk_setwindowtype)
  1903.  
  1904.        call ptk_setwindowtype(%val(windid), %val(windtype))
  1905.  
  1906.        RETURN
  1907.        END
  1908.  
  1909.  
  1910. C end of wind.f
  1911.